home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2006 May / PCpro_2006_05.ISO / files / mobile / fma-2.0-stable-setup.exe / {app} / source / uWABSync.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2004-06-25  |  31.2 KB  |  756 lines
  1. unit uWABSync;
  2.  
  3. {
  4. *******************************************************************************
  5. * Descriptions: WAB Contact Sync Unit
  6. * $Source: /cvsroot/fma/fma/uWABSync.pas,v $
  7. * $Locker:  $
  8. *
  9. * Todo:
  10. *   - Check for memory leaks
  11. *
  12. * Change Log:
  13. * $Log: uWABSync.pas,v $
  14. * Revision 1.4  2004/06/25 18:27:09  lordlarry
  15. * Added this changelog header
  16. *
  17. *
  18. }
  19.  
  20. interface
  21.  
  22. uses
  23.   uContactSync, Classes, WabIab, WabApi, WabDefs;
  24.  
  25. type
  26.   TWABContact = class(TContact)
  27.   private
  28.     FWABData: TStringList;
  29.     procedure SetWABData(const Value: TStringList);
  30.   protected
  31.     function Exists: Boolean; override;
  32.   public
  33.     constructor Create(ContactSource: TContactSource);
  34.     destructor Destroy; override;
  35.  
  36.     property WABData: TStringList read FWABData write SetWABData;
  37.   end;
  38.  
  39.   TWABContactSource = class(TContactSource)
  40.   private
  41.     FFilePath: String;
  42.     AddrBook: IAddrBook;
  43.     WabObject: IWabObject;
  44.     procedure FreeSBinary(var P: PSBinary);
  45.     procedure FreeSRowSet(var P: PSRowSet);
  46.   protected
  47.     function GetName: String; override;
  48.     procedure Read(Contact: TWABContact; WABData: TStringList);
  49.     procedure OpenWAB;
  50.     procedure CloseWAB;
  51.     procedure EntryIDDataToWABData(EntryIDData: PSBinary; WABData: TStringList);
  52.   public
  53.     destructor Destroy; override;
  54.  
  55.     function New: TContact; override;
  56.     function Add(Value: TContact): TContact; override;
  57.     procedure Update(Contact, Value: TContact); override;
  58.     procedure Delete(Contact: TContact); override;
  59.  
  60.     procedure Load; override;
  61.  
  62.     property FilePath: String read FFilePath write FFilePath;
  63.   end;
  64.  
  65. implementation
  66.  
  67. uses ComObj, Windows, WabTags, Forms, SysUtils;
  68.  
  69. function SPropValueToStr(PropValue: TSPropValue): string;
  70. var
  71.   LT: TFileTime;
  72.   ST: TSystemTime;
  73. begin
  74.   with PropValue do
  75.     case PROP_TYPE(ulPropTag) of
  76.       PT_TSTRING:
  77.         Result := Value.lpszA;
  78.       PT_BINARY:
  79.         if Value.bin.cb = 4 then
  80.           Result := Format('$%.8x', [PDWORD(Value.bin.lpb)^])
  81.         else
  82.           Result := Format('[Binary - Size: %d bytes]', [Value.bin.cb]);
  83.       PT_I2:
  84.         Result := IntToStr(Value.i);
  85.       PT_LONG:
  86.         Result := IntToStr(Value.l);
  87.       PT_R4:
  88.         Result := FloatToStr(Value.flt);
  89.       PT_DOUBLE:
  90.         Result := FloatToStr(Value.dbl);
  91.       PT_BOOLEAN:
  92.         Result := IntToStr(Value.b);
  93.       PT_SYSTIME:
  94.         begin
  95.           FileTimeToLocalFileTime(Value.ft, LT);
  96.           FileTimeToSystemTime(LT, ST);
  97.           Result := DateTimeToStr(SystemTimeToDateTime(ST));
  98.         end;
  99.       PT_ERROR:
  100.         Result := '';
  101.     else
  102.       Result := Format('[Unknown type %x]', [PROP_TYPE(ulPropTag)]);
  103.     end;
  104. end;
  105.  
  106. function StrToSPropValue(const TextValue: String; var PropValue: TSPropValue): Boolean;
  107. begin
  108.   Result := True;
  109.   with PropValue do
  110.     case PROP_TYPE(ulPropTag) of
  111.       PT_TSTRING:
  112.         Value.lpszA := PChar(TextValue);
  113.       PT_I2:
  114.         Value.i := StrToInt(TextValue);
  115.       PT_LONG:
  116.         Value.l := StrToInt(TextValue);
  117.       PT_R4:
  118.         Value.flt := StrToFloat(TextValue);
  119.       PT_DOUBLE:
  120.         Value.dbl := StrToFloat(TextValue);
  121.       PT_BOOLEAN:
  122.         Value.b := StrToInt(TextValue);
  123.     else
  124.       Result := False;
  125.     end;
  126. end;
  127.  
  128. function IsPropSimpleEditable(PropValue: TSPropValue): Boolean;
  129. begin
  130.   case PROP_TYPE(PropValue.ulPropTag) of
  131.     PT_TSTRING, PT_I2, PT_LONG, PT_R4, PT_DOUBLE, PT_BOOLEAN:
  132.       Result := True;
  133.   else
  134.     Result := False;
  135.   end;
  136. end;        
  137.  
  138. function SPropValueToTypeStr(PropValue: TSPropValue): string;
  139. const
  140.   TagNames: array[1..321] of record
  141.     Tag: ULONG;
  142.     Name: PChar
  143.   end = (
  144.     (Tag: PR_ENTRYID; Name: 'ENTRYID'),
  145.     (Tag: PR_OBJECT_TYPE; Name: 'OBJECT_TYPE'),
  146.     (Tag: PR_ICON; Name: 'ICON'),
  147.     (Tag: PR_MINI_ICON; Name: 'MINI_ICON'),
  148.     (Tag: PR_STORE_ENTRYID; Name: 'STORE_ENTRYID'),
  149.     (Tag: PR_STORE_RECORD_KEY; Name: 'STORE_RECORD_KEY'),
  150.     (Tag: PR_RECORD_KEY; Name: 'RECORD_KEY'),
  151.     (Tag: PR_MAPPING_SIGNATURE; Name: 'MAPPING_SIGNATURE'),
  152.     (Tag: PR_ACCESS_LEVEL; Name: 'ACCESS_LEVEL'),
  153.     (Tag: PR_INSTANCE_KEY; Name: 'INSTANCE_KEY'),
  154.     (Tag: PR_ROW_TYPE; Name: 'ROW_TYPE'),
  155.     (Tag: PR_ACCESS; Name: 'ACCESS'),
  156.     (Tag: PR_ROWID; Name: 'ROWID'),
  157.     (Tag: PR_DISPLAY_NAME; Name: 'DISPLAY_NAME'),
  158.     (Tag: PR_DISPLAY_NAME_W; Name: 'DISPLAY_NAME_W'),
  159.     (Tag: PR_DISPLAY_NAME_A; Name: 'DISPLAY_NAME_A'),
  160.     (Tag: PR_ADDRTYPE; Name: 'ADDRTYPE'),
  161.     (Tag: PR_ADDRTYPE_W; Name: 'ADDRTYPE_W'),
  162.     (Tag: PR_ADDRTYPE_A; Name: 'ADDRTYPE_A'),
  163.     (Tag: PR_EMAIL_ADDRESS; Name: 'EMAIL_ADDRESS'),
  164.     (Tag: PR_EMAIL_ADDRESS_W; Name: 'EMAIL_ADDRESS_W'),
  165.     (Tag: PR_EMAIL_ADDRESS_A; Name: 'EMAIL_ADDRESS_A'),
  166.     (Tag: PR_COMMENT; Name: 'COMMENT'),
  167.     (Tag: PR_COMMENT_W; Name: 'COMMENT_W'),
  168.     (Tag: PR_COMMENT_A; Name: 'COMMENT_A'),
  169.     (Tag: PR_DEPTH; Name: 'DEPTH'),
  170.     (Tag: PR_PROVIDER_DISPLAY; Name: 'PROVIDER_DISPLAY'),
  171.     (Tag: PR_PROVIDER_DISPLAY_W; Name: 'PROVIDER_DISPLAY_W'),
  172.     (Tag: PR_PROVIDER_DISPLAY_A; Name: 'PROVIDER_DISPLAY_A'),
  173.     (Tag: PR_CREATION_TIME; Name: 'CREATION_TIME'),
  174.     (Tag: PR_LAST_MODIFICATION_TIME; Name: 'LAST_MODIFICATION_TIME'),
  175.     (Tag: PR_RESOURCE_FLAGS; Name: 'RESOURCE_FLAGS'),
  176.     (Tag: PR_PROVIDER_DLL_NAME; Name: 'PROVIDER_DLL_NAME'),
  177.     (Tag: PR_PROVIDER_DLL_NAME_W; Name: 'PROVIDER_DLL_NAME_W'),
  178.     (Tag: PR_PROVIDER_DLL_NAME_A; Name: 'PROVIDER_DLL_NAME_A'),
  179.     (Tag: PR_SEARCH_KEY; Name: 'SEARCH_KEY'),
  180.     (Tag: PR_PROVIDER_UID; Name: 'PROVIDER_UID'),
  181.     (Tag: PR_PROVIDER_ORDINAL; Name: 'PROVIDER_ORDINAL'),
  182.     (Tag: PR_CONTAINER_FLAGS; Name: 'CONTAINER_FLAGS'),
  183.     (Tag: PR_FOLDER_TYPE; Name: 'FOLDER_TYPE'),
  184.     (Tag: PR_CONTENT_COUNT; Name: 'CONTENT_COUNT'),
  185.     (Tag: PR_CONTENT_UNREAD; Name: 'CONTENT_UNREAD'),
  186.     (Tag: PR_CREATE_TEMPLATES; Name: 'CREATE_TEMPLATES'),
  187.     (Tag: PR_DETAILS_TABLE; Name: 'DETAILS_TABLE'),
  188.     (Tag: PR_SEARCH; Name: 'SEARCH'),
  189.     (Tag: PR_SELECTABLE; Name: 'SELECTABLE'),
  190.     (Tag: PR_SUBFOLDERS; Name: 'SUBFOLDERS'),
  191.     (Tag: PR_STATUS; Name: 'STATUS'),
  192.     (Tag: PR_ANR; Name: 'ANR'),
  193.     (Tag: PR_ANR_W; Name: 'ANR_W'),
  194.     (Tag: PR_ANR_A; Name: 'ANR_A'),
  195.     (Tag: PR_CONTENTS_SORT_ORDER; Name: 'CONTENTS_SORT_ORDER'),
  196.     (Tag: PR_CONTAINER_HIERARCHY; Name: 'CONTAINER_HIERARCHY'),
  197.     (Tag: PR_CONTAINER_CONTENTS; Name: 'CONTAINER_CONTENTS'),
  198.     (Tag: PR_FOLDER_ASSOCIATED_CONTENTS; Name: 'FOLDER_ASSOCIATED_CONTENTS'),
  199.     (Tag: PR_DEF_CREATE_DL; Name: 'DEF_CREATE_DL'),
  200.     (Tag: PR_DEF_CREATE_MAILUSER; Name: 'DEF_CREATE_MAILUSER'),
  201.     (Tag: PR_CONTAINER_CLASS; Name: 'CONTAINER_CLASS'),
  202.     (Tag: PR_CONTAINER_CLASS_W; Name: 'CONTAINER_CLASS_W'),
  203.     (Tag: PR_CONTAINER_CLASS_A; Name: 'CONTAINER_CLASS_A'),
  204.     (Tag: PR_CONTAINER_MODIFY_VERSION; Name: 'CONTAINER_MODIFY_VERSION'),
  205.     (Tag: PR_AB_PROVIDER_ID; Name: 'AB_PROVIDER_ID'),
  206.     (Tag: PR_DEFAULT_VIEW_ENTRYID; Name: 'DEFAULT_VIEW_ENTRYID'),
  207.     (Tag: PR_ASSOC_CONTENT_COUNT; Name: 'ASSOC_CONTENT_COUNT'),
  208.     (Tag: PR_DISPLAY_TYPE; Name: 'DISPLAY_TYPE'),
  209.     (Tag: PR_TEMPLATEID; Name: 'TEMPLATEID'),
  210.     (Tag: PR_PRIMARY_CAPABILITY; Name: 'PRIMARY_CAPABILITY'),
  211.     (Tag: PR_7BIT_DISPLAY_NAME; Name: '7BIT_DISPLAY_NAME'),
  212.     (Tag: PR_ACCOUNT; Name: 'ACCOUNT'),
  213.     (Tag: PR_ACCOUNT_W; Name: 'ACCOUNT_W'),
  214.     (Tag: PR_ACCOUNT_A; Name: 'ACCOUNT_A'),
  215.     (Tag: PR_ALTERNATE_RECIPIENT; Name: 'ALTERNATE_RECIPIENT'),
  216.     (Tag: PR_CALLBACK_TELEPHONE_NUMBER; Name: 'CALLBACK_TELEPHONE_NUMBER'),
  217.     (Tag: PR_CALLBACK_TELEPHONE_NUMBER_W; Name: 'CALLBACK_TELEPHONE_NUMBER_W'),
  218.     (Tag: PR_CALLBACK_TELEPHONE_NUMBER_A; Name: 'CALLBACK_TELEPHONE_NUMBER_A'),
  219.     (Tag: PR_CONVERSION_PROHIBITED; Name: 'CONVERSION_PROHIBITED'),
  220.     (Tag: PR_DISCLOSE_RECIPIENTS; Name: 'DISCLOSE_RECIPIENTS'),
  221.     (Tag: PR_GENERATION; Name: 'GENERATION'),
  222.     (Tag: PR_GENERATION_W; Name: 'GENERATION_W'),
  223.     (Tag: PR_GENERATION_A; Name: 'GENERATION_A'),
  224.     (Tag: PR_GIVEN_NAME; Name: 'GIVEN_NAME'),
  225.     (Tag: PR_GIVEN_NAME_W; Name: 'GIVEN_NAME_W'),
  226.     (Tag: PR_GIVEN_NAME_A; Name: 'GIVEN_NAME_A'),
  227.     (Tag: PR_GOVERNMENT_ID_NUMBER; Name: 'GOVERNMENT_ID_NUMBER'),
  228.     (Tag: PR_GOVERNMENT_ID_NUMBER_W; Name: 'GOVERNMENT_ID_NUMBER_W'),
  229.     (Tag: PR_GOVERNMENT_ID_NUMBER_A; Name: 'GOVERNMENT_ID_NUMBER_A'),
  230.     (Tag: PR_BUSINESS_TELEPHONE_NUMBER; Name: 'BUSINESS_TELEPHONE_NUMBER'),
  231.     (Tag: PR_BUSINESS_TELEPHONE_NUMBER_W; Name: 'BUSINESS_TELEPHONE_NUMBER_W'),
  232.     (Tag: PR_BUSINESS_TELEPHONE_NUMBER_A; Name: 'BUSINESS_TELEPHONE_NUMBER_A'),
  233.     (Tag: PR_OFFICE_TELEPHONE_NUMBER; Name: 'OFFICE_TELEPHONE_NUMBER'),
  234.     (Tag: PR_OFFICE_TELEPHONE_NUMBER_W; Name: 'OFFICE_TELEPHONE_NUMBER_W'),
  235.     (Tag: PR_OFFICE_TELEPHONE_NUMBER_A; Name: 'OFFICE_TELEPHONE_NUMBER_A'),
  236.     (Tag: PR_HOME_TELEPHONE_NUMBER; Name: 'HOME_TELEPHONE_NUMBER'),
  237.     (Tag: PR_HOME_TELEPHONE_NUMBER_W; Name: 'HOME_TELEPHONE_NUMBER_W'),
  238.     (Tag: PR_HOME_TELEPHONE_NUMBER_A; Name: 'HOME_TELEPHONE_NUMBER_A'),
  239.     (Tag: PR_INITIALS; Name: 'INITIALS'),
  240.     (Tag: PR_INITIALS_W; Name: 'INITIALS_W'),
  241.     (Tag: PR_INITIALS_A; Name: 'INITIALS_A'),
  242.     (Tag: PR_KEYWORD; Name: 'KEYWORD'),
  243.     (Tag: PR_KEYWORD_W; Name: 'KEYWORD_W'),
  244.     (Tag: PR_KEYWORD_A; Name: 'KEYWORD_A'),
  245.     (Tag: PR_LANGUAGE; Name: 'LANGUAGE'),
  246.     (Tag: PR_LANGUAGE_W; Name: 'LANGUAGE_W'),
  247.     (Tag: PR_LANGUAGE_A; Name: 'LANGUAGE_A'),
  248.     (Tag: PR_LOCATION; Name: 'LOCATION'),
  249.     (Tag: PR_LOCATION_W; Name: 'LOCATION_W'),
  250.     (Tag: PR_LOCATION_A; Name: 'LOCATION_A'),
  251.     (Tag: PR_MAIL_PERMISSION; Name: 'MAIL_PERMISSION'),
  252.     (Tag: PR_MHS_COMMON_NAME; Name: 'MHS_COMMON_NAME'),
  253.     (Tag: PR_MHS_COMMON_NAME_W; Name: 'MHS_COMMON_NAME_W'),
  254.     (Tag: PR_MHS_COMMON_NAME_A; Name: 'MHS_COMMON_NAME_A'),
  255.     (Tag: PR_ORGANIZATIONAL_ID_NUMBER; Name: 'ORGANIZATIONAL_ID_NUMBER'),
  256.     (Tag: PR_ORGANIZATIONAL_ID_NUMBER_W; Name: 'ORGANIZATIONAL_ID_NUMBER_W'),
  257.     (Tag: PR_ORGANIZATIONAL_ID_NUMBER_A; Name: 'ORGANIZATIONAL_ID_NUMBER_A'),
  258.     (Tag: PR_SURNAME; Name: 'SURNAME'),
  259.     (Tag: PR_SURNAME_W; Name: 'SURNAME_W'),
  260.     (Tag: PR_SURNAME_A; Name: 'SURNAME_A'),
  261.     (Tag: PR_ORIGINAL_ENTRYID; Name: 'ORIGINAL_ENTRYID'),
  262.     (Tag: PR_ORIGINAL_DISPLAY_NAME; Name: 'ORIGINAL_DISPLAY_NAME'),
  263.     (Tag: PR_ORIGINAL_DISPLAY_NAME_W; Name: 'ORIGINAL_DISPLAY_NAME_W'),
  264.     (Tag: PR_ORIGINAL_DISPLAY_NAME_A; Name: 'ORIGINAL_DISPLAY_NAME_A'),
  265.     (Tag: PR_ORIGINAL_SEARCH_KEY; Name: 'ORIGINAL_SEARCH_KEY'),
  266.     (Tag: PR_POSTAL_ADDRESS; Name: 'POSTAL_ADDRESS'),
  267.     (Tag: PR_POSTAL_ADDRESS_W; Name: 'POSTAL_ADDRESS_W'),
  268.     (Tag: PR_POSTAL_ADDRESS_A; Name: 'POSTAL_ADDRESS_A'),
  269.     (Tag: PR_COMPANY_NAME; Name: 'COMPANY_NAME'),
  270.     (Tag: PR_COMPANY_NAME_W; Name: 'COMPANY_NAME_W'),
  271.     (Tag: PR_COMPANY_NAME_A; Name: 'COMPANY_NAME_A'),
  272.     (Tag: PR_TITLE; Name: 'TITLE'),
  273.     (Tag: PR_TITLE_W; Name: 'TITLE_W'),
  274.     (Tag: PR_TITLE_A; Name: 'TITLE_A'),
  275.     (Tag: PR_DEPARTMENT_NAME; Name: 'DEPARTMENT_NAME'),
  276.     (Tag: PR_DEPARTMENT_NAME_W; Name: 'DEPARTMENT_NAME_W'),
  277.     (Tag: PR_DEPARTMENT_NAME_A; Name: 'DEPARTMENT_NAME_A'),
  278.     (Tag: PR_OFFICE_LOCATION; Name: 'OFFICE_LOCATION'),
  279.     (Tag: PR_OFFICE_LOCATION_W; Name: 'OFFICE_LOCATION_W'),
  280.     (Tag: PR_OFFICE_LOCATION_A; Name: 'OFFICE_LOCATION_A'),
  281.     (Tag: PR_PRIMARY_TELEPHONE_NUMBER; Name: 'PRIMARY_TELEPHONE_NUMBER'),
  282.     (Tag: PR_PRIMARY_TELEPHONE_NUMBER_W; Name: 'PRIMARY_TELEPHONE_NUMBER_W'),
  283.     (Tag: PR_PRIMARY_TELEPHONE_NUMBER_A; Name: 'PRIMARY_TELEPHONE_NUMBER_A'),
  284.     (Tag: PR_BUSINESS2_TELEPHONE_NUMBER; Name: 'BUSINESS2_TELEPHONE_NUMBER'),
  285.     (Tag: PR_BUSINESS2_TELEPHONE_NUMBER_W; Name: 'BUSINESS2_TELEPHONE_NUMBER_W'),
  286.     (Tag: PR_BUSINESS2_TELEPHONE_NUMBER_A; Name: 'BUSINESS2_TELEPHONE_NUMBER_A'),
  287.     (Tag: PR_OFFICE2_TELEPHONE_NUMBER; Name: 'OFFICE2_TELEPHONE_NUMBER'),
  288.     (Tag: PR_OFFICE2_TELEPHONE_NUMBER_W; Name: 'OFFICE2_TELEPHONE_NUMBER_W'),
  289.     (Tag: PR_OFFICE2_TELEPHONE_NUMBER_A; Name: 'OFFICE2_TELEPHONE_NUMBER_A'),
  290.     (Tag: PR_MOBILE_TELEPHONE_NUMBER; Name: 'MOBILE_TELEPHONE_NUMBER'),
  291.     (Tag: PR_MOBILE_TELEPHONE_NUMBER_W; Name: 'MOBILE_TELEPHONE_NUMBER_W'),
  292.     (Tag: PR_MOBILE_TELEPHONE_NUMBER_A; Name: 'MOBILE_TELEPHONE_NUMBER_A'),
  293.     (Tag: PR_CELLULAR_TELEPHONE_NUMBER; Name: 'CELLULAR_TELEPHONE_NUMBER'),
  294.     (Tag: PR_CELLULAR_TELEPHONE_NUMBER_W; Name: 'CELLULAR_TELEPHONE_NUMBER_W'),
  295.     (Tag: PR_CELLULAR_TELEPHONE_NUMBER_A; Name: 'CELLULAR_TELEPHONE_NUMBER_A'),
  296.     (Tag: PR_RADIO_TELEPHONE_NUMBER; Name: 'RADIO_TELEPHONE_NUMBER'),
  297.     (Tag: PR_RADIO_TELEPHONE_NUMBER_W; Name: 'RADIO_TELEPHONE_NUMBER_W'),
  298.     (Tag: PR_RADIO_TELEPHONE_NUMBER_A; Name: 'RADIO_TELEPHONE_NUMBER_A'),
  299.     (Tag: PR_CAR_TELEPHONE_NUMBER; Name: 'CAR_TELEPHONE_NUMBER'),
  300.     (Tag: PR_CAR_TELEPHONE_NUMBER_W; Name: 'CAR_TELEPHONE_NUMBER_W'),
  301.     (Tag: PR_CAR_TELEPHONE_NUMBER_A; Name: 'CAR_TELEPHONE_NUMBER_A'),
  302.     (Tag: PR_OTHER_TELEPHONE_NUMBER; Name: 'OTHER_TELEPHONE_NUMBER'),
  303.     (Tag: PR_OTHER_TELEPHONE_NUMBER_W; Name: 'OTHER_TELEPHONE_NUMBER_W'),
  304.     (Tag: PR_OTHER_TELEPHONE_NUMBER_A; Name: 'OTHER_TELEPHONE_NUMBER_A'),
  305.     (Tag: PR_TRANSMITABLE_DISPLAY_NAME; Name: 'TRANSMITABLE_DISPLAY_NAME'),
  306.     (Tag: PR_TRANSMITABLE_DISPLAY_NAME_W; Name: 'TRANSMITABLE_DISPLAY_NAME_W'),
  307.     (Tag: PR_TRANSMITABLE_DISPLAY_NAME_A; Name: 'TRANSMITABLE_DISPLAY_NAME_A'),
  308.     (Tag: PR_PAGER_TELEPHONE_NUMBER; Name: 'PAGER_TELEPHONE_NUMBER'),
  309.     (Tag: PR_PAGER_TELEPHONE_NUMBER_W; Name: 'PAGER_TELEPHONE_NUMBER_W'),
  310.     (Tag: PR_PAGER_TELEPHONE_NUMBER_A; Name: 'PAGER_TELEPHONE_NUMBER_A'),
  311.     (Tag: PR_BEEPER_TELEPHONE_NUMBER; Name: 'BEEPER_TELEPHONE_NUMBER'),
  312.     (Tag: PR_BEEPER_TELEPHONE_NUMBER_W; Name: 'BEEPER_TELEPHONE_NUMBER_W'),
  313.     (Tag: PR_BEEPER_TELEPHONE_NUMBER_A; Name: 'BEEPER_TELEPHONE_NUMBER_A'),
  314.     (Tag: PR_USER_CERTIFICATE; Name: 'USER_CERTIFICATE'),
  315.     (Tag: PR_PRIMARY_FAX_NUMBER; Name: 'PRIMARY_FAX_NUMBER'),
  316.     (Tag: PR_PRIMARY_FAX_NUMBER_W; Name: 'PRIMARY_FAX_NUMBER_W'),
  317.     (Tag: PR_PRIMARY_FAX_NUMBER_A; Name: 'PRIMARY_FAX_NUMBER_A'),
  318.     (Tag: PR_BUSINESS_FAX_NUMBER; Name: 'BUSINESS_FAX_NUMBER'),
  319.     (Tag: PR_BUSINESS_FAX_NUMBER_W; Name: 'BUSINESS_FAX_NUMBER_W'),
  320.     (Tag: PR_BUSINESS_FAX_NUMBER_A; Name: 'BUSINESS_FAX_NUMBER_A'),
  321.     (Tag: PR_HOME_FAX_NUMBER; Name: 'HOME_FAX_NUMBER'),
  322.     (Tag: PR_HOME_FAX_NUMBER_W; Name: 'HOME_FAX_NUMBER_W'),
  323.     (Tag: PR_HOME_FAX_NUMBER_A; Name: 'HOME_FAX_NUMBER_A'),
  324.     (Tag: PR_COUNTRY; Name: 'COUNTRY'),
  325.     (Tag: PR_COUNTRY_W; Name: 'COUNTRY_W'),
  326.     (Tag: PR_COUNTRY_A; Name: 'COUNTRY_A'),
  327.     (Tag: PR_LOCALITY; Name: 'LOCALITY'),
  328.     (Tag: PR_LOCALITY_W; Name: 'LOCALITY_W'),
  329.     (Tag: PR_LOCALITY_A; Name: 'LOCALITY_A'),
  330.     (Tag: PR_STATE_OR_PROVINCE; Name: 'STATE_OR_PROVINCE'),
  331.     (Tag: PR_STATE_OR_PROVINCE_W; Name: 'STATE_OR_PROVINCE_W'),
  332.     (Tag: PR_STATE_OR_PROVINCE_A; Name: 'STATE_OR_PROVINCE_A'),
  333.     (Tag: PR_STREET_ADDRESS; Name: 'STREET_ADDRESS'),
  334.     (Tag: PR_STREET_ADDRESS_W; Name: 'STREET_ADDRESS_W'),
  335.     (Tag: PR_STREET_ADDRESS_A; Name: 'STREET_ADDRESS_A'),
  336.     (Tag: PR_POSTAL_CODE; Name: 'POSTAL_CODE'),
  337.     (Tag: PR_POSTAL_CODE_W; Name: 'POSTAL_CODE_W'),
  338.     (Tag: PR_POSTAL_CODE_A; Name: 'POSTAL_CODE_A'),
  339.     (Tag: PR_POST_OFFICE_BOX; Name: 'POST_OFFICE_BOX'),
  340.     (Tag: PR_POST_OFFICE_BOX_W; Name: 'POST_OFFICE_BOX_W'),
  341.     (Tag: PR_POST_OFFICE_BOX_A; Name: 'POST_OFFICE_BOX_A'),
  342.     (Tag: PR_BUSINESS_ADDRESS_POST_OFFICE_BOX; Name: 'BUSINESS_ADDRESS_POST_OFFICE_BOX'),
  343.     (Tag: PR_BUSINESS_ADDRESS_POST_OFFICE_BOX_W; Name: 'BUSINESS_ADDRESS_POST_OFFICE_BOX_W'),
  344.     (Tag: PR_BUSINESS_ADDRESS_POST_OFFICE_BOX_A; Name: 'BUSINESS_ADDRESS_POST_OFFICE_BOX_A'),
  345.     (Tag: PR_TELEX_NUMBER; Name: 'TELEX_NUMBER'),
  346.     (Tag: PR_TELEX_NUMBER_W; Name: 'TELEX_NUMBER_W'),
  347.     (Tag: PR_TELEX_NUMBER_A; Name: 'TELEX_NUMBER_A'),
  348.     (Tag: PR_ISDN_NUMBER; Name: 'ISDN_NUMBER'),
  349.     (Tag: PR_ISDN_NUMBER_W; Name: 'ISDN_NUMBER_W'),
  350.     (Tag: PR_ISDN_NUMBER_A; Name: 'ISDN_NUMBER_A'),
  351.     (Tag: PR_ASSISTANT_TELEPHONE_NUMBER; Name: 'ASSISTANT_TELEPHONE_NUMBER'),
  352.     (Tag: PR_ASSISTANT_TELEPHONE_NUMBER_W; Name: 'ASSISTANT_TELEPHONE_NUMBER_W'),
  353.     (Tag: PR_ASSISTANT_TELEPHONE_NUMBER_A; Name: 'ASSISTANT_TELEPHONE_NUMBER_A'),
  354.     (Tag: PR_HOME2_TELEPHONE_NUMBER; Name: 'HOME2_TELEPHONE_NUMBER'),
  355.     (Tag: PR_HOME2_TELEPHONE_NUMBER_W; Name: 'HOME2_TELEPHONE_NUMBER_W'),
  356.     (Tag: PR_HOME2_TELEPHONE_NUMBER_A; Name: 'HOME2_TELEPHONE_NUMBER_A'),
  357.     (Tag: PR_ASSISTANT; Name: 'ASSISTANT'),
  358.     (Tag: PR_ASSISTANT_W; Name: 'ASSISTANT_W'),
  359.     (Tag: PR_ASSISTANT_A; Name: 'ASSISTANT_A'),
  360.     (Tag: PR_SEND_RICH_INFO; Name: 'SEND_RICH_INFO'),
  361.     (Tag: PR_WEDDING_ANNIVERSARY; Name: 'WEDDING_ANNIVERSARY'),
  362.     (Tag: PR_BIRTHDAY; Name: 'BIRTHDAY'),
  363.     (Tag: PR_HOBBIES; Name: 'HOBBIES'),
  364.     (Tag: PR_HOBBIES_W; Name: 'HOBBIES_W'),
  365.     (Tag: PR_HOBBIES_A; Name: 'HOBBIES_A'),
  366.     (Tag: PR_MIDDLE_NAME; Name: 'MIDDLE_NAME'),
  367.     (Tag: PR_MIDDLE_NAME_W; Name: 'MIDDLE_NAME_W'),
  368.     (Tag: PR_MIDDLE_NAME_A; Name: 'MIDDLE_NAME_A'),
  369.     (Tag: PR_DISPLAY_NAME_PREFIX; Name: 'DISPLAY_NAME_PREFIX'),
  370.     (Tag: PR_DISPLAY_NAME_PREFIX_W; Name: 'DISPLAY_NAME_PREFIX_W'),
  371.     (Tag: PR_DISPLAY_NAME_PREFIX_A; Name: 'DISPLAY_NAME_PREFIX_A'),
  372.     (Tag: PR_PROFESSION; Name: 'PROFESSION'),
  373.     (Tag: PR_PROFESSION_W; Name: 'PROFESSION_W'),
  374.     (Tag: PR_PROFESSION_A; Name: 'PROFESSION_A'),
  375.     (Tag: PR_PREFERRED_BY_NAME; Name: 'PREFERRED_BY_NAME'),
  376.     (Tag: PR_PREFERRED_BY_NAME_W; Name: 'PREFERRED_BY_NAME_W'),
  377.     (Tag: PR_PREFERRED_BY_NAME_A; Name: 'PREFERRED_BY_NAME_A'),
  378.     (Tag: PR_SPOUSE_NAME; Name: 'SPOUSE_NAME'),
  379.     (Tag: PR_SPOUSE_NAME_W; Name: 'SPOUSE_NAME_W'),
  380.     (Tag: PR_SPOUSE_NAME_A; Name: 'SPOUSE_NAME_A'),
  381.     (Tag: PR_COMPUTER_NETWORK_NAME; Name: 'COMPUTER_NETWORK_NAME'),
  382.     (Tag: PR_COMPUTER_NETWORK_NAME_W; Name: 'COMPUTER_NETWORK_NAME_W'),
  383.     (Tag: PR_COMPUTER_NETWORK_NAME_A; Name: 'COMPUTER_NETWORK_NAME_A'),
  384.     (Tag: PR_CUSTOMER_ID; Name: 'CUSTOMER_ID'),
  385.     (Tag: PR_CUSTOMER_ID_W; Name: 'CUSTOMER_ID_W'),
  386.     (Tag: PR_CUSTOMER_ID_A; Name: 'CUSTOMER_ID_A'),
  387.     (Tag: PR_TTYTDD_PHONE_NUMBER; Name: 'TTYTDD_PHONE_NUMBER'),
  388.     (Tag: PR_TTYTDD_PHONE_NUMBER_W; Name: 'TTYTDD_PHONE_NUMBER_W'),
  389.     (Tag: PR_TTYTDD_PHONE_NUMBER_A; Name: 'TTYTDD_PHONE_NUMBER_A'),
  390.     (Tag: PR_FTP_SITE; Name: 'FTP_SITE'),
  391.     (Tag: PR_FTP_SITE_W; Name: 'FTP_SITE_W'),
  392.     (Tag: PR_FTP_SITE_A; Name: 'FTP_SITE_A'),
  393.     (Tag: PR_GENDER; Name: 'GENDER'),
  394.     (Tag: PR_MANAGER_NAME; Name: 'MANAGER_NAME'),
  395.     (Tag: PR_MANAGER_NAME_W; Name: 'MANAGER_NAME_W'),
  396.     (Tag: PR_MANAGER_NAME_A; Name: 'MANAGER_NAME_A'),
  397.     (Tag: PR_NICKNAME; Name: 'NICKNAME'),
  398.     (Tag: PR_NICKNAME_W; Name: 'NICKNAME_W'),
  399.     (Tag: PR_NICKNAME_A; Name: 'NICKNAME_A'),
  400.     (Tag: PR_PERSONAL_HOME_PAGE; Name: 'PERSONAL_HOME_PAGE'),
  401.     (Tag: PR_PERSONAL_HOME_PAGE_W; Name: 'PERSONAL_HOME_PAGE_W'),
  402.     (Tag: PR_PERSONAL_HOME_PAGE_A; Name: 'PERSONAL_HOME_PAGE_A'),
  403.     (Tag: PR_BUSINESS_HOME_PAGE; Name: 'BUSINESS_HOME_PAGE'),
  404.     (Tag: PR_BUSINESS_HOME_PAGE_W; Name: 'BUSINESS_HOME_PAGE_W'),
  405.     (Tag: PR_BUSINESS_HOME_PAGE_A; Name: 'BUSINESS_HOME_PAGE_A'),
  406.     (Tag: PR_CONTACT_VERSION; Name: 'CONTACT_VERSION'),
  407.     (Tag: PR_CONTACT_ENTRYIDS; Name: 'CONTACT_ENTRYIDS'),
  408.     (Tag: PR_CONTACT_ADDRTYPES; Name: 'CONTACT_ADDRTYPES'),
  409.     (Tag: PR_CONTACT_ADDRTYPES_W; Name: 'CONTACT_ADDRTYPES_W'),
  410.     (Tag: PR_CONTACT_ADDRTYPES_A; Name: 'CONTACT_ADDRTYPES_A'),
  411.     (Tag: PR_CONTACT_DEFAULT_ADDRESS_INDEX; Name: 'CONTACT_DEFAULT_ADDRESS_INDEX'),
  412.     (Tag: PR_CONTACT_EMAIL_ADDRESSES; Name: 'CONTACT_EMAIL_ADDRESSES'),
  413.     (Tag: PR_CONTACT_EMAIL_ADDRESSES_W; Name: 'CONTACT_EMAIL_ADDRESSES_W'),
  414.     (Tag: PR_CONTACT_EMAIL_ADDRESSES_A; Name: 'CONTACT_EMAIL_ADDRESSES_A'),
  415.     (Tag: PR_COMPANY_MAIN_PHONE_NUMBER; Name: 'COMPANY_MAIN_PHONE_NUMBER'),
  416.     (Tag: PR_COMPANY_MAIN_PHONE_NUMBER_W; Name: 'COMPANY_MAIN_PHONE_NUMBER_W'),
  417.     (Tag: PR_COMPANY_MAIN_PHONE_NUMBER_A; Name: 'COMPANY_MAIN_PHONE_NUMBER_A'),
  418.     (Tag: PR_CHILDRENS_NAMES; Name: 'CHILDRENS_NAMES'),
  419.     (Tag: PR_CHILDRENS_NAMES_W; Name: 'CHILDRENS_NAMES_W'),
  420.     (Tag: PR_CHILDRENS_NAMES_A; Name: 'CHILDRENS_NAMES_A'),
  421.     (Tag: PR_HOME_ADDRESS_CITY; Name: 'HOME_ADDRESS_CITY'),
  422.     (Tag: PR_HOME_ADDRESS_CITY_W; Name: 'HOME_ADDRESS_CITY_W'),
  423.     (Tag: PR_HOME_ADDRESS_CITY_A; Name: 'HOME_ADDRESS_CITY_A'),
  424.     (Tag: PR_HOME_ADDRESS_COUNTRY; Name: 'HOME_ADDRESS_COUNTRY'),
  425.     (Tag: PR_HOME_ADDRESS_COUNTRY_W; Name: 'HOME_ADDRESS_COUNTRY_W'),
  426.     (Tag: PR_HOME_ADDRESS_COUNTRY_A; Name: 'HOME_ADDRESS_COUNTRY_A'),
  427.     (Tag: PR_HOME_ADDRESS_POSTAL_CODE; Name: 'HOME_ADDRESS_POSTAL_CODE'),
  428.     (Tag: PR_HOME_ADDRESS_POSTAL_CODE_W; Name: 'HOME_ADDRESS_POSTAL_CODE_W'),
  429.     (Tag: PR_HOME_ADDRESS_POSTAL_CODE_A; Name: 'HOME_ADDRESS_POSTAL_CODE_A'),
  430.     (Tag: PR_HOME_ADDRESS_STATE_OR_PROVINCE; Name: 'HOME_ADDRESS_STATE_OR_PROVINCE'),
  431.     (Tag: PR_HOME_ADDRESS_STATE_OR_PROVINCE_W; Name: 'HOME_ADDRESS_STATE_OR_PROVINCE_W'),
  432.     (Tag: PR_HOME_ADDRESS_STATE_OR_PROVINCE_A; Name: 'HOME_ADDRESS_STATE_OR_PROVINCE_A'),
  433.     (Tag: PR_HOME_ADDRESS_STREET; Name: 'HOME_ADDRESS_STREET'),
  434.     (Tag: PR_HOME_ADDRESS_STREET_W; Name: 'HOME_ADDRESS_STREET_W'),
  435.     (Tag: PR_HOME_ADDRESS_STREET_A; Name: 'HOME_ADDRESS_STREET_A'),
  436.     (Tag: PR_HOME_ADDRESS_POST_OFFICE_BOX; Name: 'HOME_ADDRESS_POST_OFFICE_BOX'),
  437.     (Tag: PR_HOME_ADDRESS_POST_OFFICE_BOX_W; Name: 'HOME_ADDRESS_POST_OFFICE_BOX_W'),
  438.     (Tag: PR_HOME_ADDRESS_POST_OFFICE_BOX_A; Name: 'HOME_ADDRESS_POST_OFFICE_BOX_A'),
  439.     (Tag: PR_OTHER_ADDRESS_CITY; Name: 'OTHER_ADDRESS_CITY'),
  440.     (Tag: PR_OTHER_ADDRESS_CITY_W; Name: 'OTHER_ADDRESS_CITY_W'),
  441.     (Tag: PR_OTHER_ADDRESS_CITY_A; Name: 'OTHER_ADDRESS_CITY_A'),
  442.     (Tag: PR_OTHER_ADDRESS_COUNTRY; Name: 'OTHER_ADDRESS_COUNTRY'),
  443.     (Tag: PR_OTHER_ADDRESS_COUNTRY_W; Name: 'OTHER_ADDRESS_COUNTRY_W'),
  444.     (Tag: PR_OTHER_ADDRESS_COUNTRY_A; Name: 'OTHER_ADDRESS_COUNTRY_A'),
  445.     (Tag: PR_OTHER_ADDRESS_POSTAL_CODE; Name: 'OTHER_ADDRESS_POSTAL_CODE'),
  446.     (Tag: PR_OTHER_ADDRESS_POSTAL_CODE_W; Name: 'OTHER_ADDRESS_POSTAL_CODE_W'),
  447.     (Tag: PR_OTHER_ADDRESS_POSTAL_CODE_A; Name: 'OTHER_ADDRESS_POSTAL_CODE_A'),
  448.     (Tag: PR_OTHER_ADDRESS_STATE_OR_PROVINCE; Name: 'OTHER_ADDRESS_STATE_OR_PROVINCE'),
  449.     (Tag: PR_OTHER_ADDRESS_STATE_OR_PROVINCE_W; Name: 'OTHER_ADDRESS_STATE_OR_PROVINCE_W'),
  450.     (Tag: PR_OTHER_ADDRESS_STATE_OR_PROVINCE_A; Name: 'OTHER_ADDRESS_STATE_OR_PROVINCE_A'),
  451.     (Tag: PR_OTHER_ADDRESS_STREET; Name: 'OTHER_ADDRESS_STREET'),
  452.     (Tag: PR_OTHER_ADDRESS_STREET_W; Name: 'OTHER_ADDRESS_STREET_W'),
  453.     (Tag: PR_OTHER_ADDRESS_STREET_A; Name: 'OTHER_ADDRESS_STREET_A'),
  454.     (Tag: PR_OTHER_ADDRESS_POST_OFFICE_BOX; Name: 'OTHER_ADDRESS_POST_OFFICE_BOX'),
  455.     (Tag: PR_OTHER_ADDRESS_POST_OFFICE_BOX_W; Name: 'OTHER_ADDRESS_POST_OFFICE_BOX_W'),
  456.     (Tag: PR_OTHER_ADDRESS_POST_OFFICE_BOX_A; Name: 'OTHER_ADDRESS_POST_OFFICE_BOX_A'),
  457.     (Tag: PR_USER_X509_CERTIFICATE; Name: 'USER_X509_CERTIFICATE'),
  458.     (Tag: PR_SEND_INTERNET_ENCODING; Name: 'SEND_INTERNET_ENCODING'),
  459.     (Tag: PR_BUSINESS_ADDRESS_CITY; Name: 'BUSINESS_ADDRESS_CITY'),
  460.     (Tag: PR_BUSINESS_ADDRESS_COUNTRY; Name: 'BUSINESS_ADDRESS_COUNTRY'),
  461.     (Tag: PR_BUSINESS_ADDRESS_POSTAL_CODE; Name: 'BUSINESS_ADDRESS_POSTAL_CODE'),
  462.     (Tag: PR_BUSINESS_ADDRESS_STATE_OR_PROVINCE; Name: 'BUSINESS_ADDRESS_STATE_OR_PROVINCE'),
  463.     (Tag: PR_BUSINESS_ADDRESS_STREET; Name: 'BUSINESS_ADDRESS_STREET'),
  464.     (Tag: PR_RECIPIENT_TYPE; Name: 'RECIPIENT_TYPE')
  465.       );
  466. var
  467.   I: Integer;
  468.   PropID: ULONG;
  469. begin
  470.   Result := '';
  471.   PropID := PROP_ID(PropValue.ulPropTag);
  472.   for I := Low(TagNames) to High(TagNames) do
  473.     if PROP_ID(TagNames[I].Tag) = PropID then
  474.     begin
  475.       Result := TagNames[I].Name;
  476.       Break;
  477.     end;
  478.   if Result = '' then Result := Format('[%x]', [PropID]);
  479. end;
  480.  
  481. { TWABContactSource }
  482.  
  483. function TWABContactSource.Add(Value: TContact): TContact;
  484. var
  485.   WabEntryID, WabNewEntryID: PEntryID;
  486.   WabEntryIDSize, WabNewEntryIDSize: ULONG;
  487.   Wnd: ULONG;
  488.   Res: HResult;
  489.   Contact: TWABContact;
  490. begin
  491.   Contact := New as TWABContact;
  492.   Contact.Clone(Value);
  493.   Contact.LinkedContact := Value;
  494.   Value.LinkedContact := Contact;
  495.   Contacts.Add(Contact);
  496.  
  497.   { TODO : Create new WAB item }
  498. {  OleCheck(HrGetWABTemplateID(MAPI_MAILUSER, WabEntryIDSize, WabEntryID));
  499.   Wnd := Application.Handle;
  500.   Res := AddrBook.NewEntry(Wnd, 0, 0, nil, WabEntryIDSize, WabEntryID,
  501.     WabNewEntryIDSize, WabNewEntryID);
  502.   if Res <> MAPI_E_USER_CANCEL then OleCheck(Res);}
  503.  
  504.   with Contact.WABData do begin
  505.     Values['TITLE'] := Contact.Title;
  506.     Values['GIVEN_NAME'] := Contact.Name;
  507.     Values['SURNAME'] := Contact.SurName;
  508.     Values['COMPANY_NAME'] := Contact.Organization;
  509.     Values['EMAIL_ADDRESS'] := Contact.Email;
  510.     Values['HOME_TELEPHONE_NUMBER'] := Contact.HomePhone;
  511.     Values['OFFICE_TELEPHONE_NUMBER'] := Contact.WorkPhone;
  512.     Values['MOBILE_TELEPHONE_NUMBER'] := Contact.CellPhone;
  513.     Values['HOME_FAX_NUMBER'] := Contact.FaxPhone;
  514.     Values['OTHER_TELEPHONE_NUMBER'] := Contact.OtherPhone;
  515.  
  516.     { TODO : Write it to WAB }
  517.  
  518.     Contact.ID := Values['ENTRYID'];
  519.   end;
  520.  
  521.   Result := Contact;
  522. end;
  523.  
  524. procedure TWABContactSource.CloseWAB;
  525. begin
  526.   AddrBook := nil;
  527.   WabObject := nil;
  528. end;
  529.  
  530. procedure TWABContactSource.Delete(Contact: TContact);
  531. var
  532.   Container: IABContainer;
  533.   WabEntryID: PEntryID;
  534.   WabEntryIDSize, ObjType: ULONG;
  535.   BinArray: TSBinaryArray;
  536. begin
  537.   with Contact as TWABContact do begin
  538.     OleCheck(AddrBook.GetPAB(WabEntryIDSize, WabEntryID));
  539.     OleCheck(AddrBook.OpenEntry(WabEntryIDSize, WabEntryID, nil, 0, ObjType, IUnknown(Container)));
  540.     BinArray.cValues := 1;
  541. //    BinArray.lpbin := EntryIDData;  // ID to delete 
  542.     OleCheck(Container.DeleteEntries(PEntryList(@BinArray), 0));
  543.     OleCheck(WabObject.FreeBuffer(WabEntryID));
  544.  
  545.     WABData.Clear;
  546.   end;
  547. end;
  548.  
  549. destructor TWABContactSource.Destroy;
  550. begin
  551.   CloseWab;
  552.  
  553.   inherited;
  554. end;
  555.  
  556. procedure TWABContactSource.EntryIDDataToWABData(EntryIDData: PSBinary; WABData: TStringList);
  557. var MailUser: IMailUser;
  558.     ObjType: ULONG;
  559.     Count: Integer;
  560.     Details: PSPropsArray;
  561.     I: Integer;
  562. begin
  563.   WABData.Clear;
  564.   if EntryIDData = nil then Exit;
  565.  
  566.   ObjType := 0;
  567.   OleCheck(AddrBook.OpenEntry(EntryIDData^.cb, EntryIDData^.lpb, nil, 0, ObjType, IUnknown(MailUser)));
  568.   OleCheck(MailUser.GetProps(nil, 0, @Count, PSPropValue(Details)));
  569.   try
  570.     for I := 0 to Count - 1 do
  571.       WABData.Add(SPropValueToTypeStr(Details[I]) + WABData.NameValueSeparator + SPropValueToStr(Details[I]));
  572.   finally
  573.     OleCheck(WabObject.FreeBuffer(Details));
  574.   end;
  575. end;
  576.  
  577. procedure TWABContactSource.FreeSBinary(var P: PSBinary);
  578. begin
  579.   if P = nil then Exit;
  580.   FreeMem(P.lpb);
  581.   Dispose(P);
  582.   P := nil;
  583. end;
  584.  
  585. procedure TWABContactSource.FreeSRowSet(var P: PSRowSet);
  586. var
  587.   I: Integer;
  588. begin
  589.   for I := 0 to P^.cRows - 1 do
  590.     OleCheck(WabObject.FreeBuffer(P^.aRow[I].lpProps));
  591.   OleCheck(WabObject.FreeBuffer(P));
  592.   P := nil;
  593. end;
  594.  
  595. function TWABContactSource.GetName: String;
  596. begin
  597.   Result := 'WAB';
  598. end;
  599.  
  600. procedure TWABContactSource.Load;
  601. const
  602.   TableColumns: record // SizedSPropTagArray macro
  603.     Count: ULONG;
  604.     Definition: array[0..4] of ULONG;
  605.   end = (
  606.     Count: 5;
  607.     Definition:
  608.       (PR_DISPLAY_NAME,
  609.        PR_EMAIL_ADDRESS,
  610.        PR_PERSONAL_HOME_PAGE,
  611.        PR_ENTRYID,
  612.        PR_OBJECT_TYPE);
  613.    );
  614. var Container: IABContainer;
  615.     EntryID: PEntryID;
  616.     EntryIDSize, ObjType: ULONG;
  617.     Table: IMAPITable;
  618.     TableRow: PSRowSet;
  619.     EntryIDData: PSBinary;
  620.     Contact: TWABContact;
  621.     WabData: TStringList;
  622. begin
  623.   if not WabApiLoaded then Exit;
  624.  
  625.   OpenWAB;
  626.  
  627.   OleCheck(AddrBook.GetPAB(EntryIDSize, EntryID));
  628.   OleCheck(AddrBook.OpenEntry(EntryIDSize, EntryID, nil, 0,
  629.     ObjType, IUnknown(Container)));
  630.   OleCheck(WabObject.FreeBuffer(EntryID));
  631.  
  632.   OleCheck(Container.GetContentsTable(0, Table));
  633.   OleCheck(Table.SetColumns(@TableColumns, 0));
  634.   OleCheck(Table.SeekRow(BOOKMARK_BEGINNING, 0, nil));
  635.  
  636.   WABData := TStringList.Create;
  637.   try
  638.     repeat
  639.       OleCheck(Table.QueryRows(1, 0, TableRow));
  640.       if TableRow.cRows > 0 then with TableRow^.aRow[0] do begin
  641.         if ULONG(lpProps[4].Value.l) in [MAPI_MAILUSER, MAPI_DISTLIST] then begin
  642.           EntryID := lpProps[3].Value.bin.lpb;
  643.           EntryIDSize := lpProps[3].Value.bin.cb;
  644.  
  645.           OleCheck(WabObject.AllocateBuffer(Sizeof(TSBinary), Pointer(EntryIDData)));
  646.           OleCheck(WabObject.AllocateMore(EntryIDSize, EntryIDData, Pointer(EntryIDData.lpb)));
  647.           CopyMemory(EntryIDData.lpb, EntryID, EntryIDSize);
  648.           EntryIDData^.cb := EntryIDSize;
  649.  
  650.           EntryIDDataToWABData(EntryIDData, WABData);
  651.  
  652.           Contact := Contacts.FindByID(WABData.Values['ENTRYID']) as TWABContact;
  653.  
  654.           if Assigned(Contact) then begin
  655.             Contact.WABData := WABData;
  656.           end
  657.           else begin
  658.             Contact := New as TWABContact;
  659.             Contact.ID := WABData.Values['ENTRYID'];
  660.             Contact.SyncHash := Contact.Hash;
  661.             Contact.WABData := WABData;
  662.             Contacts.Add(Contact);
  663.           end;
  664.  
  665.           Read(Contact, WABData);
  666.  
  667.           Application.ProcessMessages;
  668.         end;
  669.         FreeSRowSet(TableRow);
  670.       end
  671.       else
  672.         Break;
  673.     until False;
  674.   finally
  675.     WABData.Free;
  676.   end;
  677. end;
  678.  
  679. function TWABContactSource.New: TContact;
  680. begin
  681.   Result := TWABContact.Create(Self);
  682. end;
  683.  
  684. procedure TWABContactSource.OpenWAB;
  685. var
  686.   WP: TWabParam;
  687. begin
  688.   ZeroMemory(@WP, Sizeof(WP));
  689.   WP.cbSize := Sizeof(WP);
  690.   WP.szFileName := PChar(FFilePath);
  691.   WP.hwnd := Application.Handle;
  692.   OleCheck(WabOpen(AddrBook, WabObject, @WP, 0));
  693. end;
  694.  
  695. procedure TWABContactSource.Read(Contact: TWABContact; WABData: TStringList);
  696. begin
  697.   with WABData do begin
  698.     Contact.Title := Values['TITLE'];
  699.     Contact.Name := Values['GIVEN_NAME'];
  700.     Contact.SurName := Values['SURNAME'];
  701.     Contact.Organization := Values['COMPANY_NAME'];
  702.     Contact.Email := Values['EMAIL_ADDRESS'];
  703.     Contact.HomePhone := DeformatPhoneNumber(Values['HOME_TELEPHONE_NUMBER']);
  704.     Contact.WorkPhone := DeformatPhoneNumber(Values['OFFICE_TELEPHONE_NUMBER']);
  705.     Contact.CellPhone := DeformatPhoneNumber(Values['MOBILE_TELEPHONE_NUMBER']);
  706.     Contact.FaxPhone := DeformatPhoneNumber(Values['HOME_FAX_NUMBER']);
  707.     Contact.OtherPhone := DeformatPhoneNumber(Values['OTHER_TELEPHONE_NUMBER']);
  708.   end;
  709. end;
  710.  
  711. procedure TWABContactSource.Update(Contact, Value: TContact);
  712. begin
  713.   with (Contact as TWABContact).WABData do begin
  714.     Values['TITLE'] := Value.Title;
  715.     Values['GIVEN_NAME'] := Value.Name;
  716.     Values['SURNAME'] := Value.SurName;
  717.     Values['COMPANY_NAME'] := Value.Organization;
  718.     Values['EMAIL_ADDRESS'] := Value.Email;
  719.     Values['HOME_TELEPHONE_NUMBER'] := Value.HomePhone;
  720.     Values['OFFICE_TELEPHONE_NUMBER'] := Value.WorkPhone;
  721.     Values['MOBILE_TELEPHONE_NUMBER'] := Value.CellPhone;
  722.     Values['HOME_FAX_NUMBER'] := Value.FaxPhone;
  723.     Values['OTHER_TELEPHONE_NUMBER'] := Value.OtherPhone;
  724.  
  725.     { TODO : Write it to WAB }
  726.   end;
  727. end;
  728.  
  729. { TWABContact }
  730.  
  731. constructor TWABContact.Create(ContactSource: TContactSource);
  732. begin
  733.   inherited;
  734.  
  735.   FWABData := TStringList.Create;
  736. end;
  737.  
  738. destructor TWABContact.Destroy;
  739. begin
  740.   FWABData.Free;
  741.  
  742.   inherited;
  743. end;
  744.  
  745. function TWABContact.Exists: Boolean;
  746. begin
  747.   Result := not (FWABData.Count = 0);
  748. end;
  749.  
  750. procedure TWABContact.SetWABData(const Value: TStringList);
  751. begin
  752.   FWABData.Assign(Value);
  753. end;
  754.  
  755. end.
  756.